home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
PROGRAMR
/
L2C_19.ZIP
/
AI_UTILS.LSP
< prev
next >
Wrap
Text File
|
1993-06-25
|
14KB
|
485 lines
;;;----------------------------------------------------------------------------
;;;
;;; AI_UTILS.LSP Version 0.5
;;;
;;; Copyright (C) 1991-1992 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; all supporting documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;----------------------------------------------------------------------------
;;; (ai_abort <appname> [<error message>] )
;;;
;;; Displays critical error message in alert box and terminates all
;;; running applications.
;;;
;;; If <errmsg> is nil, no alert box or error message is displayed.
(defun ai_abort (app msg)
(defun *error* (s)
(if old_error (setq *error* old_error))
(princ)
)
(if msg
(alert (strcat " Application error: "
app
" \n\n "
msg
" \n"
)
)
)
(exit)
)
(defun ai_return (value) value) ; Make act of returning value explicit
;;; Beep function conditional on user-preferred setting.
(defun ai_beep ( / f)
(write-line "\007" (setq f (open "CON" "w")))
(setq f (close f))
)
;;; (ai_alert <message> )
;;;
;;; Shell for (alert)
(defun ai_alert (msg)
(if ai_beep? (ai_beep))
(alert (strcat " " msg " "))
)
;;; (ai_acadapp)
;;;
;;; Check to see if acadapp is loaded (and load if necessary).
;;;
;;; If ACADAPP is not loaded, then display a message indicating
;;; such in an alert box, and return NIL to the caller. This
;;; function does not generate an error condition, so if that is
;;; appropriate, then the caller must test the result and generate
;;; the error condition itself.
;;;
(defun ai_acadapp ( / fname)
(setq fname (ai_acadapp_fn))
(cond
( (= (type acad_colordlg) 'EXSUBR)) ; it's already loaded.
( (not (findfile fname)) ; find it
(ai_alert (strcat "Can't find " fname "."))
(ai_return nil))
( (eq "failed" (xload fname "failed")) ; load it
(ai_alert (strcat "Can't load " fname "."))
(ai_return nil))
(t)
)
)
;;; (ai_acadapp_fn)
;;;
;;; This function returns the filename & extension of the ADS
;;; ACADAPP executable for every platform.
;;; Default filename is "acadapp" (in lower-case).
(defun ai_acadapp_fn ( / platform)
(setq platform (getvar "platform"))
(cond
( (eq platform "Windows") "ACADAPP.EXE")
( (eq platform "386 DOS Extender") "ACADAPP.EXP")
;;;
;;; insert other cases as required.
;;;
(t "acadapp") ; Default extension
)
)
;;; (ai_table <table name> <bit> )
;;;
;;; Returns a list of items in the specified table. The bit values have the
;;; following meaning:
;;; 0 List all items in the specified table.
;;; 1 Do not list Layer 0 and Linetype CONTINUOUS.
;;; 2 Do not list anonymous blocks.
;;; A check against the 70 flag for the following bit:
;;; 1 anonymous block
;;; 4 Do not list externally dependant items.
;;; A check against the 70 flag is made for any of the following
;;; bits, which add up to 48:
;;; 16 externally dependant
;;; 32 resolved external or dependant
;;; 8 Do not list Xrefs.
;;; A check against the 70 flag for the following bit:
;;; 4 external reference
;;; 16 Add BYBLOCK and BYLAYER items to list.
;;;
(defun ai_table (table_name bit / tbldata table_list just_name)
(setq tbldata nil)
(setq table_list '())
(setq table_name (strcase table_name))
(while (setq tbldata (tblnext table_name (not tbldata)))
(setq just_name (cdr (assoc 2 tbldata)))
(cond
((= "" just_name)) ; Never return null Shape names.
((and (= 1 (logand bit 1))
(or (and (= table_name "LAYER") (= just_name "0"))
(and (= table_name "LTYPE")
(= just_name "CONTINUOUS")
)
)
))
((and (= 2 (logand bit 2))
(= table_name "BLOCK")
(= 1 (logand 1 (cdr (assoc 70 tbldata))))
))
((and (= 4 (logand bit 4))
;; Check for Xref dependents only.
(zerop (logand 4 (cdr (assoc 70 tbldata))))
(not (zerop (logand 48 (cdr (assoc 70 tbldata)))))
))
((and (= 8 (logand bit 8))
(not (zerop (logand 4 (cdr (assoc 70 tbldata)))))
))
;; Vports tables can have similar names, only display one.
((member just_name table_list)
)
(T (setq table_list (cons just_name table_list)))
)
)
(cond
((and (= 16 (logand bit 16))
(= table_name "LTYPE") ) (setq table_list (cons "BYBLOCK"
(cons "BYLAYER" table_list))) )
(t)
)
(ai_return table_list)
)
;;;
;;; (ai_strtrim <string> )
;;;
;;; Trims leading and trailing spaces from strings.
(defun ai_strtrim (s)
(cond
((/= (type s) 'str) nil)
(t (ai_strltrim (ai_strrtrim s)))
)
)
(defun ai_strltrim (s)
(cond
((eq s "") s)
((/= " " (substr s 1 1)) s)
(t (ai_strltrim (substr s 2)))
)
)
(defun ai_strrtrim (s)
(cond
((eq s "") s)
((/= " " (substr s (strlen s) 1)) s)
(t (ai_strrtrim (substr s 1 (1- (strlen s)))))
)
)
;;;
;;; Pass a number, an error message, and a range. If the value is good, it is
;;; returned, else an error is displayed.
;;; Range values:
;;; 0 - any numeric input OK
;;; 1 - reject positive
;;; 2 - reject negative
;;; 4 - reject zero
;;;
(defun ai_num (value error_msg range / good_value)
(cond
;; is it a number
((not (setq good_value (distof value)))
(set_tile "error" error_msg)
nil
)
;; is it positive
((and (= 1 (logand 1 range))
(= (abs good_value) good_value)
)
(set_tile "error" error_msg)
nil
)
;; is it zero
((and (= 2 (logand 2 range))
(= 0.0 good_value)
)
(set_tile "error" error_msg)
nil
)
;; is it negative
((and (= 4 (logand 4 range))
(/= (abs good_value) good_value)
)
(set_tile "error" error_msg)
nil
)
(T good_value)
)
)
;;;
;;; Pass an angle and an error message. If good, the angle is returned else
;;; nil and an error message displayed.
;;;
(defun ai_angle(value error_msg / good_value)
(cond
((and (setq good_value (angtof value))
)
(set_tile "error" "")
(atof (angtos good_value))
)
(T (set_tile "error" error_msg) nil)
)
)
;;;
;;; Error routine.
;;;
(defun ai_error (s) ; If an error (such as CTRL-C) occurs
(if (not (member s '("Function cancelled" "console break")))
(princ (strcat "\nError: " s))
)
(if undo_init (ai_undo_pop)) ; Deal with UNDO
(if old_error (setq *error* old_error)) ; Restore old *error* handler
(if old_cmd (setvar "cmdecho" old_cmd)) ; Restore cmdecho value
(princ)
)
;;;
;;; Routines that check CMDACTIVE and post an alert if the calling routine
;;; should not be called in the current CMDACTIVE state. The calling
;;; routine calls (ai_trans) if it can be called transparently or
;;; (ai_notrans) if it cannot.
;;;
;;; 1 - Ordinary command active.
;;; 2 - Ordinary and transparent command active.
;;; 4 - Script file active.
;;; 8 - Dia